home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_l.arc / PROGS.ARC / calc.icn < prev    next >
Encoding:
Text File  |  1990-03-08  |  4.1 KB  |  159 lines
  1. ############################################################################
  2. #
  3. #    Name:    calc.icn
  4. #
  5. #    Title:    Desk calculator
  6. #
  7. #    Author:    Ralph E. Griswold
  8. #
  9. #    Date:    February 22, 1990
  10. #
  11. ############################################################################
  12. #
  13. #  This is a simple Polish "desk calculator".  It accepts as values Icon
  14. #  integers, reals, csets, and strings (as they would appear in an Icon
  15. #  program). Other lines of input are interpreted as operations. These
  16. #  may be Icon operators, functions, or the special instructions listed
  17. #  below.
  18. #
  19. #  In the case of operator symbols, such as +, that correspond to both unary
  20. #  and binary operations, the binary one is used.  Thus, the unary operation
  21. #  is not available.
  22. #
  23. #  In case of Icon functions like write() that take an arbitrary number of
  24. #  arguments, one argument is used.
  25. #
  26. #  The special instructions are:
  27. #
  28. #    clear    remove all values from the calculator's stack
  29. #    dump    write out the contents of the stack
  30. #    print    print the top value on the stack, but do not remove it
  31. #    quit    exit the calculator
  32. #
  33. #  Example: the input lines
  34. #
  35. #    "abc"
  36. #    3
  37. #    repl
  38. #    print
  39. #
  40. #  prints "abcabcabc" and leaves this the only value on the stack.
  41. #
  42. #  Failure and most errors are detected, but in these case, arguments are
  43. #  consumed and not restored to the stack.
  44. #
  45. ############################################################################
  46.  
  47. global stack
  48.  
  49. procedure main()
  50.    local line, p, n, arglist
  51.  
  52.    stack := []
  53.  
  54.    while line := read() do {
  55.       push(stack,value(line)) | {    # if it's a value, push it
  56.          case line of {    # else check special operations
  57.             "clear":   {stack := []; next}
  58.             "dump":    {every write(image(!stack)); next}
  59.             "print":   {write(image(stack[1])); next}
  60.             "quit":    exit()
  61.             }      
  62.          if p := proc(line,3 | 2 | 1) then {    # check for procedure
  63.             n := abs(args(p))
  64.             arglist := []
  65.             every 1 to n do
  66.                push(arglist,pop(stack)) | {
  67.                   write(&errout,"*** not enough arguments ***")
  68.                   break next
  69.                   }
  70.             &error := 1    # anticipate possible error
  71.             push(stack,p!arglist) | {
  72.                if &error = 0 then {
  73.                   write(&errout,"*** error performing ",line)
  74.                   }
  75.                else write(&errout,"*** failure performing ",line)
  76.                }
  77.             }
  78.          else write(&errout,"*** invalid input: ",line)
  79.          }
  80.       }
  81. end
  82.  
  83. #  Check input to see if it's a value
  84. #
  85. procedure value(s)
  86.    local n
  87.  
  88.    if n := numeric(s) then return n
  89.    else {
  90.       s ? {
  91.          if ="\"" & s := tab(-1) & ="\"" then return escape(s)
  92.          else if ="'" & s := tab(-1) & ="'" then return cset(escape(s))
  93.          else fail
  94.          }
  95.       }
  96. end
  97.  
  98. #  Handling escape sequences is no fun
  99. #
  100. procedure escape(s)
  101.    local ns, c
  102.  
  103.    ns := ""
  104.    s ? {
  105.       while ns ||:= tab(upto('\\')) do {
  106.          move(1)
  107.          ns ||:= case c := map(move(1 | 0)) of {    # can be either case
  108.             "b":  "\b"
  109.             "d":  "\d"
  110.             "e":  "\e"
  111.             "f":  "\f"
  112.             "l":  "\n"
  113.             "n":  "\n"
  114.             "r":  "\r"
  115.             "t":  "\t"
  116.             "v":  "\v"
  117.             "'":  "'"
  118.             "\"":  "\""
  119.             "x":  hexcode()
  120.             "^":  ctrlcode()
  121.             !"01234567":  octcode()
  122.             default:  c
  123.             }
  124.          }
  125.       ns ||:= tab(0)
  126.       }
  127.    return ns
  128. end
  129.  
  130. procedure hexcode()
  131.    local i, s
  132.    static cdigs
  133.    initial cdigs := ~'0123456789ABCDEFabcdef'
  134.    
  135.    move(i := 2 | 1) ? s := tab(upto(cdigs) | 0)
  136.    move(*s - i)
  137.    return char("16r" || s)
  138. end
  139.  
  140. procedure octcode()
  141.    local i, s
  142.    static cdigs
  143.    initial cdigs := ~'01234567'
  144.    
  145.    move(-1)
  146.    move(i := 3 | 2 | 1) ? s := tab(upto(cdigs) | 0)
  147.    move(*s - i)
  148.    if s > 377 then {    # back off if too large
  149.       s := s[1:3]
  150.       move(-1)
  151.       }
  152.    return char("8r" || s)
  153. end
  154.  
  155. procedure ctrlcode(s)
  156.    return char(upto(map(move(1)),&lcase))
  157. end
  158.  
  159.